home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
17 Bit Software 6: Level 6
/
17 Bit - Level 6 (1998)(Epic Marketing)[!].iso
/
quartz
/
q0545.dms
/
q0545.adf
/
VFTest.bas
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1988-01-21
|
5KB
|
123 lines
REM ***************** TESTPROGRAMM FÜR VEKTORFONHANDLER *******************
CLEAR
' -------- Libraryfunktionen einbinden -----------
DECLARE FUNCTION FindTask& LIBRARY
DECLARE FUNCTION FindPort& LIBRARY
DECLARE FUNCTION GetMsg& LIBRARY
DECLARE FUNCTION AllocMem& LIBRARY
LIBRARY "exec.library"
DECLARE FUNCTION xOpen& LIBRARY
DECLARE FUNCTION xRead& LIBRARY
LIBRARY "dos.library"
FileName$="df0:VektorFonts/topaz.vek" : ' Vektorfontfile
OutText$="Beispieltext" : ' Ausgabetext
ErrVar&=0 : ' Fehlervariable
WINDOW 2,"Window",(0,0)-(617,180),15 : ' Ausgabefenster oeffnen
CALL LoadVekFont (FileName$) : ' Vektorfont laden
IF VFontAdr&=0 THEN
PRINT "Nicht genuegend Speicher !" : ' AllocMem erfolgreich ?
END IF
h1%=PEEKW(VFontAdr&+4) : ' Kennung pruefen
IF (h1% <> &Habcd) THEN
PRINT "Das ist kein Vektorfontfile !"
GOTO abbruch
END IF
IF MePort&=0 THEN
PRINT "Handler wurde nicht gefunden !"
GOTO abbruch
END
END IF
CALL VektorTextOut(10,10,50,50,2,OutText$,0)
CALL VektorTextOut(10,60,100,100,4,OutText$,1)
abbruch:
IF VFontAdr& <> 0 THEN CALL FreeMem(VFontAdr&,VFontLen&)
IF VMessAdr& <> 0 THEN CALL FreeMem(VMessAdr&,64)
END
' ********************* Subroutine Vektorfont laden **********************
SUB LoadVekFont (finame$) STATIC
SHARED VFontLen&,VFontAdr&,VMessAdr&,Port1$,Port2$,RePort&,MePort&
Port1$="vekfport-t0"+CHR$(0) : ' Portname Messageport
Port2$="vekfport-t1"+CHR$(0) : ' Portname ReplyPort
RePort&=0 : ' ReplyPort Adresse
MePort&=0 : ' MessagePort Adresse
VMessAdr&=0 : ' Adresse von struct VFontMess
VFontLen&=0 : ' Laenge Fontfile
VFontAdr&=0 : ' Startadresse Fontfile
OPEN finame$ FOR INPUT AS 1 : ' Filelaenge feststellen
VFontLen&=LOF(1)
CLOSE #1
VFontAdr&=AllocMem&(VFontLen&,0) : ' Speicher fuer Font belegen
IF VFontAdr&=0 THEN EXIT SUB : ' Nicht genuegend Speicher ?
a$=finame$+CHR$(0) : ' Filename terminieren
datei&=xOpen&(SADD(a$),1005) : ' Datei oeffnen
IF datei&=0 THEN
PRINT "Datei nicht gefunden !" : ' 0 - wenn Fehler
ELSE
h&=xRead&(datei&,VFontAdr&,VFontLen&) : ' datei in Speicher laden
xClose(datei&) : ' datei schliessen
CALL InitPorts : ' Messageports installieren
END IF
END SUB
' *************** Messageports von Handler Task suchen ********************
SUB InitPorts STATIC
SHARED RePort&,MePort&,Port1$,Port2$,VMessAdr&,VFontAdr&
MePort&=FindPort&(SADD(Port1$)) : ' Messageport von Handler suchen
RePort&=FindPort&(SADD(Port2$)) : ' Replyport suchen
IF MePort& <> 0 THEN
h1&=FindTask&(0) : ' Zeiger auf eigenen Task suchen
POKEL RePort&+16,h1& : ' ReplyPort auf eigenen Task setzen
POKE VMessAdr&+8,5 : ' VMess.ln_Type=NT_MESSAGE (5)
VMessAdr&=AllocMem&(64,0) : ' Speicher fuer Message anfordern
FOR i=0 TO 64
POKE VMessAdr&+i,0 : ' Speicher initialisieren
NEXT i
POKEL VMessAdr&+14,RePort& : ' ReplyPort in Message einbinden
POKEL VMessAdr&+24,VFontAdr& : ' Startadresse Fontfile
END IF
END SUB
' ***************************** Text ausgeben *****************************
SUB VektorTextOut(x&,y&,wi&,hi&,bspc&,text$,drmd&) STATIC
SHARED VMessAdr&,MePort&,RePort&,FontBuff$,ErrVar&,VFontAdr&
a$=text$+CHR$(0) : ' String terminieren
POKEL VMessAdr&+20,WINDOW(8) : ' Rastport von Ausgabefenster
POKEL VMessAdr&+28,x& : ' X-Koordinate
POKEL VMessAdr&+32,y& : ' Y-Koordinate
POKEL VMessAdr&+36,wi& : ' Fontbreite
POKEL VMessAdr&+40,hi& : ' Fonthoehe
POKEL VMessAdr&+44,bspc& : ' Zeichenabstand
POKEL VMessAdr&+48,0 : ' Flagvariable auf NULL
POKEL VMessAdr&+52,SADD(a$) : ' Startadresse Ausgabetext
POKEL VMessAdr&+56,LEN(a$) : ' Laenge des Ausgabetextes
POKEL VMessAdr&+60,drmd& : ' Zeichenmodus
CALL PutMsg(MePort&,VMessAdr&) : ' Message abschicken
CALL WaitPort(RePort&) : ' Auf Antwort warten
h1&=GetMsg&(RePort&) : ' Antwort abholen
ErrVar&=PEEKL(h1&+48) : ' Antwort auswerten
END SUB